home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacMETH 3.2.1 / Sources / MacC3.3 / M2SA.MOD < prev    next >
Encoding:
Text File  |  1992-05-29  |  15.8 KB  |  235 lines  |  [TEXT/MEDT]
  1. intval >= 400B) THEN
  2.             Mark(29); intval := 0
  3.           END;
  4.           INC(j)
  5.         END
  6.       ELSE (* decimal number *)
  7.         d1 := 0D;
  8.         WHILE j < i DO
  9.           d := ORD(dig[j]) - 60B;
  10.           IF d < 10 THEN (* no overflow check *)
  11.             d1 := d1 + d1; d0 := d1 + d1; d1 := d0 + d0 + d1 + LONG(d)
  12.           ELSE Mark(29); d1 := 0D
  13.           END;
  14.           INC(j)
  15.         END;
  16.         IF (d1 <= 32767D) THEN numtyp := 1; intval := SHORT(d1)
  17.         ELSE numtyp := 2; dblval := d1 END
  18.       END
  19.     END
  20.   END Number;
  21.  
  22. (*$R=*)
  23.  
  24.   PROCEDURE GetSym;
  25.     VAR xch: CHAR;
  26.  
  27.     PROCEDURE TestOption;
  28.  
  29.       PROCEDURE MakeOption(VAR stack: ARRAY OF BOOLEAN; VAR index: INTEGER;
  30.                            VAR option: BOOLEAN);
  31.       BEGIN
  32.         ReadChar(source, ch);
  33.         IF    ch = "+" THEN
  34.           stack[index] := option; option := TRUE;
  35.           IF index < MaxOptionLevel THEN INC(index) END;
  36.         ELSIF ch = "-" THEN
  37.           stack[index] := option; option := FALSE;
  38.           IF index < MaxOptionLevel THEN INC(index) END;
  39.         ELSIF ch = "=" THEN
  40.           IF index > 0 THEN DEC(index) END;
  41.           option := stack[index]
  42.         ELSE
  43.           Mark(230)
  44.         END;
  45.       END MakeOption;
  46.  
  47.     BEGIN
  48.       IF    ch = "R" THEN MakeOption(rOptions, rIndex, rngchk)
  49.       ELSIF ch = "V" THEN MakeOption(vOptions, vIndex, ovflchk)
  50.       ELSE
  51.         Mark(230)  (* invalid option *)
  52.       END
  53.     END TestOption;
  54.  
  55.     PROCEDURE Comment;
  56.     BEGIN ReadChar(source, ch);
  57.       REPEAT
  58.         IF ch = "$" THEN ReadChar(source, ch); TestOption END;
  59.         WHILE (ch # "*") & (ch > 0C) DO
  60.           IF ch = "(" THEN ReadChar(source, ch);
  61.             IF ch = "*" THEN Comment END
  62.           ELSE ReadChar(source, ch)
  63.           END
  64.         END;
  65.         ReadChar(source, ch)
  66.       UNTIL (ch = ")") OR (ch = 0C);
  67.       IF ch > 0C THEN ReadChar(source, ch) ELSE Mark(42) END
  68.     END Comment;
  69.  
  70.   BEGIN
  71.     LOOP (* ignore control characters *)
  72.       IF ch <= " " THEN
  73.         IF ch = 0C THEN ch := " "; EXIT ELSE ReadChar(source, ch) END;
  74.       ELSIF ch > 177C THEN ReadChar(source, ch)
  75.       ELSE EXIT
  76.       END
  77.     END;
  78.     CASE ch OF   (* " " <= ch <= 177C *)
  79.         " "  : sym := eof; ch := 0C |
  80.         "!"  : sym := null; ReadChar(source, ch) |
  81.         '"'  : String('"') |
  82.         "#"  : sym := neq; ReadChar(source, ch)  |
  83.         "$"  : sym := null; ReadChar(source, ch) |
  84.         "%"  : sym := null; ReadChar(source, ch) |
  85.         "&"  : sym := and; ReadChar(source, ch)  |
  86.         "'"  : String("'") |
  87.         "("  : ReadChar(source, ch);
  88.                IF ch = "*" THEN Comment; GetSym
  89.                  ELSE sym := lparen
  90.                END |
  91.         ")"  : sym := rparen; ReadChar(source, ch)|
  92.         "*"  : sym := times; ReadChar(source, ch) |
  93.         "+"  : sym := plus; ReadChar(source, ch)  |
  94.         ","  : sym := comma; ReadChar(source, ch) |
  95.         "-"  : sym := minus; ReadChar(source, ch) |
  96.         "."  : ReadChar(source, ch);
  97.                IF ch = "." THEN ReadChar(source, ch); sym := ellipsis
  98.                  ELSE sym := period
  99.                END |
  100.         "/"  : sym := slash; ReadChar(source, ch) |
  101.         "0".."9": Number |
  102.         ":"  : ReadChar(source, ch);
  103.                IF ch = "=" THEN ReadChar(source, ch); sym := becomes
  104.                  ELSE sym := colon
  105.                END |
  106.         ";"  : sym := semicolon; ReadChar(source, ch) |
  107.         "<"  : ReadChar(source, ch);
  108.                IF ch = "=" THEN ReadChar(source, ch); sym := leq
  109.                  ELSIF ch = ">" THEN ReadChar(source, ch); sym := neq
  110.                  ELSE sym := lss
  111.                END |
  112.         "="  : sym := eql; ReadChar(source, ch)   |
  113.         ">"  : ReadChar(source, ch);
  114.                IF ch = "=" THEN ReadChar(source, ch); sym := geq
  115.                  ELSE sym := gtr
  116.                END |
  117.         "?"  : sym := null; ReadChar(source, ch)  |
  118.         "@"  : sym := null; ReadChar(source, ch)  |
  119.         "A".."Z": Identifier       |
  120.         "["  : sym := lbrak; ReadChar(source, ch) |
  121.         "\"  : sym := null; ReadChar(source, ch)  |
  122.         "]"  : sym := rbrak; ReadChar(source, ch) |
  123.         "^"  : sym := arrow; ReadChar(source, ch) |
  124.         "_"  : sym := becomes; ReadChar(source, ch)  |
  125.         "`"  : sym := null; ReadChar(source, ch)  |
  126.         "a".."z": Identifier       |
  127.         "{"  : sym := lbrace; ReadChar(source, ch)|
  128.         "|"  : sym := bar; ReadChar(source, ch)   |
  129.         "}"  : sym := rbrace; ReadChar(source, ch)|
  130.         "~"  : sym := not; ReadChar(source, ch)   |
  131.         177C : sym := ellipsis; ReadChar(source, ch)
  132.     END
  133.   END GetSym;
  134.  
  135.   PROCEDURE Enter(name: ARRAY OF CHAR): INTEGER;
  136.     VAR j, l: INTEGER;
  137.   BEGIN l := HIGH(name) + 1; id1 := id;
  138.     IF id1+l < IdBufLeng THEN
  139.       IdBuf[id] := CHR(l); INC(id);
  140.       FOR j := 0 TO l-2 DO IdBuf[id] := name[j]; INC(id) END
  141.     END;
  142.     RETURN id1
  143.   END Enter;
  144.  
  145.   PROCEDURE InitScanner(filename: ARRAY OF CHAR);
  146.     VAR i: INTEGER;
  147.   BEGIN ch := " "; scanerr := FALSE; lastPos := 0D;
  148.     IF id0 = 0 THEN
  149.       id0 := id; Lookup(errLog, "err.LST", TRUE);
  150.       Lookup(errDat, "err.DAT", TRUE);
  151.     ELSE id := id0; WriteChar(errLog, "-"); WriteChar(errLog, 36C)
  152.     END;
  153.     WriteChar(errDat, FNM); i := 0;
  154.     WHILE (i <= HIGH(filename)) & (filename[i] # 0C) DO
  155.       WriteChar(errDat, filename[i]); INC(i);
  156.     END;
  157.     WriteChar(errDat, 0C);
  158.     rIndex := 0; vIndex := 0
  159.   END InitScanner;
  160.  
  161.   PROCEDURE CloseScanner;
  162.   BEGIN Close(errLog); Close(errDat);
  163.   END CloseScanner;
  164.  
  165.   PROCEDURE EnterKW(sym: Symbol; name: ARRAY OF CHAR);
  166.   VAR l, L: INTEGER;
  167.   BEGIN
  168.     keyTab[K].sym := sym;
  169.     keyTab[K].ind := id;
  170.     l := 0; L := HIGH(name) - 1;
  171.     IdBuf[id] := CHR(L+2); INC(id);
  172.     WHILE l <= L DO
  173.       IdBuf[id] := name[l];
  174.       INC(id); INC(l)
  175.     END;
  176.     INC(K)
  177.   END EnterKW;
  178.  
  179. BEGIN
  180.   K := 0; IdBuf[0] := 1C; id := 1; id0 := 0;
  181.   (* assert maxExp < 512 for actual pow! *)
  182.   pow[0] := FLOATD(10)       (* 1.0E1 *);
  183.   pow[1] := pow[0] * pow[0]  (* 1.0E2 *);
  184.   pow[2] := pow[1] * pow[1]  (* 1.0E4 *);
  185.   pow[3] := pow[2] * pow[2]  (* 1.0E8 *);
  186.   pow[4] := pow[3] * pow[3]  (* 1.0E16 *);
  187.   pow[5] := pow[4] * pow[4]  (* 1.0E32 *);
  188.   pow[6] := pow[5] * pow[5]  (* 1.0E64 *);
  189.   pow[7] := pow[6] * pow[6]  (* 1.0E128 *);
  190.   pow[8] := pow[7] * pow[7]  (* 1.0E256 *);
  191.   EnterKW(by,"BY");
  192.   EnterKW(do,"DO");
  193.   EnterKW(if,"IF");
  194.   EnterKW(in,"IN");
  195.   EnterKW(of,"OF");
  196.   EnterKW(or,"OR");
  197.   EnterKW(to,"TO");
  198.   EnterKW(and,"AND");
  199.   EnterKW(div,"DIV");
  200.   EnterKW(end,"END");
  201.   EnterKW(for,"FOR");
  202.   EnterKW(mod,"MOD");
  203.   EnterKW(not,"NOT");
  204.   EnterKW(rem,"REM");
  205.   EnterKW(set,"SET");
  206.   EnterKW(var,"VAR");
  207.   EnterKW(case,"CASE");
  208.   EnterKW(code,"CODE");
  209.   EnterKW(else,"ELSE");
  210.   EnterKW(exit,"EXIT");
  211.   EnterKW(from,"FROM");
  212.   EnterKW(loop,"LOOP");
  213.   EnterKW(then,"THEN");
  214.   EnterKW(type,"TYPE");
  215.   EnterKW(with,"WITH");
  216.   EnterKW(array,"ARRAY");
  217.   EnterKW(begin,"BEGIN");
  218.   EnterKW(const,"CONST");
  219.   EnterKW(elsif,"ELSIF");
  220.   EnterKW(until,"UNTIL");
  221.   EnterKW(while,"WHILE");
  222.   EnterKW(export,"EXPORT");
  223.   EnterKW(import,"IMPORT");
  224.   EnterKW(module,"MODULE");
  225.   EnterKW(record,"RECORD");
  226.   EnterKW(repeat,"REPEAT");
  227.   EnterKW(return,"RETURN");
  228.   EnterKW(forward,"FORWARD");
  229.   EnterKW(pointer,"POINTER");
  230.   EnterKW(procedure,"PROCEDURE");
  231.   EnterKW(qualified,"QUALIFIED");
  232.   EnterKW(definition,"DEFINITION");
  233.   EnterKW(implementation,"IMPLEMENTATION");
  234. END M2SA. (* Copyright Departement Informatik, ETH Zuerich, Switzerland, 1992 *)
  235.